home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / generic / tkConsole.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  16.7 KB  |  616 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tkConsole.c --
  3.  *
  4.  *    This file implements a Tcl console for systems that may not
  5.  *    otherwise have access to a console.  It uses the Text widget
  6.  *    and provides special access via a console command.
  7.  *
  8.  * Copyright (c) 1995-1996 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * SCCS: @(#) tkConsole.c 1.53 97/07/22 16:36:55
  14.  */
  15.  
  16. #include "tkInt.h"
  17.  
  18. /*
  19.  * A data structure of the following type holds information for each console
  20.  * which a handler (i.e. a Tcl command) has been defined for a particular
  21.  * top-level window.
  22.  */
  23.  
  24. typedef struct ConsoleInfo {
  25.     Tcl_Interp *consoleInterp;    /* Interpreter for the console. */
  26.     Tcl_Interp *interp;        /* Interpreter to send console commands. */
  27. } ConsoleInfo;
  28.  
  29. static Tcl_Interp *gStdoutInterp = NULL;
  30.  
  31. /*
  32.  * Forward declarations for procedures defined later in this file:
  33.  *
  34.  * The first three will be used in the tk app shells...
  35.  */
  36.  
  37. void    TkConsoleCreate _ANSI_ARGS_((void));
  38. int    TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
  39. void    TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
  40.                 int devId, char *buffer, long size));
  41.  
  42. static int    ConsoleCmd _ANSI_ARGS_((ClientData clientData,
  43.             Tcl_Interp *interp, int argc, char **argv));
  44. static void    ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
  45. static void    ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
  46.             XEvent *eventPtr));
  47. static int    InterpreterCmd _ANSI_ARGS_((ClientData clientData,
  48.             Tcl_Interp *interp, int argc, char **argv));
  49.  
  50. static int    ConsoleInput _ANSI_ARGS_((ClientData instanceData,
  51.             char *buf, int toRead, int *errorCode));
  52. static int    ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
  53.             char *buf, int toWrite, int *errorCode));
  54. static int    ConsoleClose _ANSI_ARGS_((ClientData instanceData,
  55.             Tcl_Interp *interp));
  56. static void    ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
  57.             int mask));
  58. static int    ConsoleHandle _ANSI_ARGS_((ClientData instanceData,
  59.             int direction, ClientData *handlePtr));
  60.  
  61. /*
  62.  * This structure describes the channel type structure for file based IO:
  63.  */
  64.  
  65. static Tcl_ChannelType consoleChannelType = {
  66.     "console",            /* Type name. */
  67.     NULL,            /* Always non-blocking.*/
  68.     ConsoleClose,        /* Close proc. */
  69.     ConsoleInput,        /* Input proc. */
  70.     ConsoleOutput,        /* Output proc. */
  71.     NULL,            /* Seek proc. */
  72.     NULL,            /* Set option proc. */
  73.     NULL,            /* Get option proc. */
  74.     ConsoleWatch,        /* Watch for events on console. */
  75.     ConsoleHandle,        /* Get a handle from the device. */
  76. };
  77.  
  78. /*
  79.  *----------------------------------------------------------------------
  80.  *
  81.  * TkConsoleCreate --
  82.  *
  83.  *     Create the console channels and install them as the standard
  84.  *     channels.  All I/O will be discarded until TkConsoleInit is
  85.  *     called to attach the console to a text widget.
  86.  *
  87.  * Results:
  88.  *    None.
  89.  *
  90.  * Side effects:
  91.  *    Creates the console channel and installs it as the standard
  92.  *    channels.
  93.  *
  94.  *----------------------------------------------------------------------
  95.  */
  96.  
  97. void
  98. TkConsoleCreate()
  99. {
  100.     Tcl_Channel consoleChannel;
  101.  
  102.     consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
  103.         (ClientData) TCL_STDIN, TCL_READABLE);
  104.     if (consoleChannel != NULL) {
  105.     Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
  106.     Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
  107.     }
  108.     Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
  109.     consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
  110.         (ClientData) TCL_STDOUT, TCL_WRITABLE);
  111.     if (consoleChannel != NULL) {
  112.     Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
  113.     Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
  114.     }
  115.     Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
  116.     consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
  117.         (ClientData) TCL_STDERR, TCL_WRITABLE);
  118.     if (consoleChannel != NULL) {
  119.     Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
  120.     Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
  121.     }
  122.     Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
  123. }
  124.  
  125. /*
  126.  *----------------------------------------------------------------------
  127.  *
  128.  * TkConsoleInit --
  129.  *
  130.  *    Initialize the console.  This code actually creates a new
  131.  *    application and associated interpreter.  This effectivly hides
  132.  *    the implementation from the main application.
  133.  *
  134.  * Results:
  135.  *    None.
  136.  *
  137.  * Side effects:
  138.  *    A new console it created.
  139.  *
  140.  *----------------------------------------------------------------------
  141.  */
  142.  
  143. int 
  144. TkConsoleInit(interp)
  145.     Tcl_Interp *interp;            /* Interpreter to use for prompting. */
  146. {
  147.     Tcl_Interp *consoleInterp;
  148.     ConsoleInfo *info;
  149.     Tk_Window mainWindow = Tk_MainWindow(interp);
  150. #ifdef MAC_TCL
  151.     static char initCmd[] = "source -rsrc {Console}";
  152. #else
  153.     static char initCmd[] = "source $tk_library/console.tcl";
  154. #endif
  155.     
  156.     consoleInterp = Tcl_CreateInterp();
  157.     if (consoleInterp == NULL) {
  158.     goto error;
  159.     }
  160.     
  161.     /*
  162.      * Initialized Tcl and Tk.
  163.      */
  164.  
  165.     if (Tcl_Init(consoleInterp) != TCL_OK) {
  166.     goto error;
  167.     }
  168.     if (Tk_Init(consoleInterp) != TCL_OK) {
  169.     goto error;
  170.     }
  171.     gStdoutInterp = interp;
  172.     
  173.     /* 
  174.      * Add console commands to the interp 
  175.      */
  176.     info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
  177.     info->interp = interp;
  178.     info->consoleInterp = consoleInterp;
  179.     Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
  180.         (Tcl_CmdDeleteProc *) ConsoleDeleteProc);
  181.     Tcl_CreateCommand(consoleInterp, "consoleinterp", InterpreterCmd,
  182.         (ClientData) info, (Tcl_CmdDeleteProc *) NULL);
  183.  
  184.     Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
  185.         (ClientData) info);
  186.  
  187.     Tcl_Preserve((ClientData) consoleInterp);
  188.     if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) {
  189.     /* goto error; -- no problem for now... */
  190.     printf("Eval error: %s", consoleInterp->result);
  191.     }
  192.     Tcl_Release((ClientData) consoleInterp);
  193.     return TCL_OK;
  194.     
  195.     error:
  196.     if (consoleInterp != NULL) {
  197.         Tcl_DeleteInterp(consoleInterp);
  198.     }
  199.     return TCL_ERROR;
  200. }
  201.  
  202. /*
  203.  *----------------------------------------------------------------------
  204.  *
  205.  * ConsoleOutput--
  206.  *
  207.  *    Writes the given output on the IO channel. Returns count of how
  208.  *    many characters were actually written, and an error indication.
  209.  *
  210.  * Results:
  211.  *    A count of how many characters were written is returned and an
  212.  *    error indication is returned in an output argument.
  213.  *
  214.  * Side effects:
  215.  *    Writes output on the actual channel.
  216.  *
  217.  *----------------------------------------------------------------------
  218.  */
  219.  
  220. static int
  221. ConsoleOutput(instanceData, buf, toWrite, errorCode)
  222.     ClientData instanceData;        /* Indicates which device to use. */
  223.     char *buf;                /* The data buffer. */
  224.     int toWrite;            /* How many bytes to write? */
  225.     int *errorCode;            /* Where to store error code. */
  226. {
  227.     *errorCode = 0;
  228.     Tcl_SetErrno(0);
  229.  
  230.     if (gStdoutInterp != NULL) {
  231.     TkConsolePrint(gStdoutInterp, (int) instanceData, buf, toWrite);
  232.     }
  233.     
  234.     return toWrite;
  235. }
  236.  
  237. /*
  238.  *----------------------------------------------------------------------
  239.  *
  240.  * ConsoleInput --
  241.  *
  242.  *    Read input from the console.  Not currently implemented.
  243.  *
  244.  * Results:
  245.  *    Always returns EOF.
  246.  *
  247.  * Side effects:
  248.  *    None.
  249.  *
  250.  *----------------------------------------------------------------------
  251.  */
  252.  
  253.     /* ARGSUSED */
  254. static int
  255. ConsoleInput(instanceData, buf, bufSize, errorCode)
  256.     ClientData instanceData;        /* Unused. */
  257.     char *buf;                /* Where to store data read. */
  258.     int bufSize;            /* How much space is available
  259.                                          * in the buffer? */
  260.     int *errorCode;            /* Where to store error code. */
  261. {
  262.     return 0;            /* Always return EOF. */
  263. }
  264.  
  265. /*
  266.  *----------------------------------------------------------------------
  267.  *
  268.  * ConsoleClose --
  269.  *
  270.  *    Closes the IO channel.
  271.  *
  272.  * Results:
  273.  *    Always returns 0 (success).
  274.  *
  275.  * Side effects:
  276.  *    Frees the dummy file associated with the channel.
  277.  *
  278.  *----------------------------------------------------------------------
  279.  */
  280.  
  281.     /* ARGSUSED */
  282. static int
  283. ConsoleClose(instanceData, interp)
  284.     ClientData instanceData;    /* Unused. */
  285.     Tcl_Interp *interp;        /* Unused. */
  286. {
  287.     return 0;
  288. }
  289.  
  290. /*
  291.  *----------------------------------------------------------------------
  292.  *
  293.  * ConsoleWatch --
  294.  *
  295.  *    Called by the notifier to set up the console device so that
  296.  *    events will be noticed. Since there are no events on the
  297.  *    console, this routine just returns without doing anything.
  298.  *
  299.  * Results:
  300.  *    None.
  301.  *
  302.  * Side effects:
  303.  *    None.
  304.  *
  305.  *----------------------------------------------------------------------
  306.  */
  307.  
  308.     /* ARGSUSED */
  309. static void
  310. ConsoleWatch(instanceData, mask)
  311.     ClientData instanceData;        /* Device ID for the channel. */
  312.     int mask;                /* OR-ed combination of
  313.                                          * TCL_READABLE, TCL_WRITABLE and
  314.                                          * TCL_EXCEPTION, for the events
  315.                                          * we are interested in. */
  316. {
  317. }
  318.  
  319. /*
  320.  *----------------------------------------------------------------------
  321.  *
  322.  * ConsoleHandle --
  323.  *
  324.  *    Invoked by the generic IO layer to get a handle from a channel.
  325.  *    Because console channels are not devices, this function always
  326.  *    fails.
  327.  *
  328.  * Results:
  329.  *    Always returns TCL_ERROR.
  330.  *
  331.  * Side effects:
  332.  *    None.
  333.  *
  334.  *----------------------------------------------------------------------
  335.  */
  336.  
  337.     /* ARGSUSED */
  338. static int
  339. ConsoleHandle(instanceData, direction, handlePtr)
  340.     ClientData instanceData;    /* Device ID for the channel. */
  341.     int direction;        /* TCL_READABLE or TCL_WRITABLE to indicate
  342.                  * which direction of the channel is being
  343.                  * requested. */
  344.     ClientData *handlePtr;    /* Where to store handle */
  345. {
  346.     return TCL_ERROR;
  347. }
  348.  
  349. /*
  350.  *----------------------------------------------------------------------
  351.  *
  352.  * ConsoleCmd --
  353.  *
  354.  *    The console command implements a Tcl interface to the various console
  355.  *    options.
  356.  *
  357.  * Results:
  358.  *    None.
  359.  *
  360.  * Side effects:
  361.  *    None.
  362.  *
  363.  *----------------------------------------------------------------------
  364.  */
  365.  
  366. static int
  367. ConsoleCmd(clientData, interp, argc, argv)
  368.     ClientData clientData;        /* Not used. */
  369.     Tcl_Interp *interp;            /* Current interpreter. */
  370.     int argc;                /* Number of arguments. */
  371.     char **argv;            /* Argument strings. */
  372. {
  373.     ConsoleInfo *info = (ConsoleInfo *) clientData;
  374.     char c;
  375.     int length;
  376.     int result;
  377.     Tcl_Interp *consoleInterp;
  378.  
  379.     if (argc < 2) {
  380.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  381.         " option ?arg arg ...?\"", (char *) NULL);
  382.     return TCL_ERROR;
  383.     }
  384.     
  385.     c = argv[1][0];
  386.     length = strlen(argv[1]);
  387.     result = TCL_OK;
  388.     consoleInterp = info->consoleInterp;
  389.     Tcl_Preserve((ClientData) consoleInterp);
  390.     if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) {
  391.     Tcl_DString dString;
  392.     
  393.     Tcl_DStringInit(&dString);
  394.     Tcl_DStringAppend(&dString, "wm title . ", -1);
  395.     if (argc == 3) {
  396.         Tcl_DStringAppendElement(&dString, argv[2]);
  397.     }
  398.     Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
  399.     Tcl_DStringFree(&dString);
  400.     } else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
  401.     Tcl_Eval(info->consoleInterp, "wm withdraw .");
  402.     } else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
  403.     Tcl_Eval(info->consoleInterp, "wm deiconify .");
  404.     } else if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
  405.     if (argc == 3) {
  406.         Tcl_Eval(info->consoleInterp, argv[2]);
  407.     } else {
  408.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  409.             " eval command\"", (char *) NULL);
  410.         return TCL_ERROR;
  411.     }
  412.     } else {
  413.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  414.         "\": should be hide, show, or title",
  415.         (char *) NULL);
  416.         result = TCL_ERROR;
  417.     }
  418.     Tcl_Release((ClientData) consoleInterp);
  419.     return result;
  420. }
  421.  
  422. /*
  423.  *----------------------------------------------------------------------
  424.  *
  425.  * InterpreterCmd --
  426.  *
  427.  *    This command allows the console interp to communicate with the
  428.  *    main interpreter.
  429.  *
  430.  * Results:
  431.  *    None.
  432.  *
  433.  * Side effects:
  434.  *    None.
  435.  *
  436.  *----------------------------------------------------------------------
  437.  */
  438.  
  439. static int
  440. InterpreterCmd(clientData, interp, argc, argv)
  441.     ClientData clientData;        /* Not used. */
  442.     Tcl_Interp *interp;            /* Current interpreter. */
  443.     int argc;                /* Number of arguments. */
  444.     char **argv;            /* Argument strings. */
  445. {
  446.     ConsoleInfo *info = (ConsoleInfo *) clientData;
  447.     char c;
  448.     int length;
  449.     int result;
  450.     Tcl_Interp *otherInterp;
  451.  
  452.     if (argc < 2) {
  453.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  454.         " option ?arg arg ...?\"", (char *) NULL);
  455.     return TCL_ERROR;
  456.     }
  457.     
  458.     c = argv[1][0];
  459.     length = strlen(argv[1]);
  460.     otherInterp = info->interp;
  461.     Tcl_Preserve((ClientData) otherInterp);
  462.     if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
  463.        result = Tcl_GlobalEval(otherInterp, argv[2]);
  464.         Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
  465.     } else if ((c == 'r') && (strncmp(argv[1], "record", length)) == 0) {
  466.        Tcl_RecordAndEval(otherInterp, argv[2], TCL_EVAL_GLOBAL);
  467.     result = TCL_OK;
  468.         Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
  469.     } else {
  470.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  471.         "\": should be eval or record",
  472.         (char *) NULL);
  473.     result = TCL_ERROR;
  474.     }
  475.     Tcl_Release((ClientData) otherInterp);
  476.     return result;
  477. }
  478.  
  479. /*
  480.  *----------------------------------------------------------------------
  481.  *
  482.  * ConsoleDeleteProc --
  483.  *
  484.  *    If the console command is deleted we destroy the console window
  485.  *    and all associated data structures.
  486.  *
  487.  * Results:
  488.  *    None.
  489.  *
  490.  * Side effects:
  491.  *    A new console it created.
  492.  *
  493.  *----------------------------------------------------------------------
  494.  */
  495.  
  496. void 
  497. ConsoleDeleteProc(clientData) 
  498.     ClientData clientData;
  499. {
  500.     ConsoleInfo *info = (ConsoleInfo *) clientData;
  501.  
  502.     Tcl_DeleteInterp(info->consoleInterp);
  503.     info->consoleInterp = NULL;
  504. }
  505.  
  506. /*
  507.  *----------------------------------------------------------------------
  508.  *
  509.  * ConsoleEventProc --
  510.  *
  511.  *    This event procedure is registered on the main window of the
  512.  *    slave interpreter.  If the user or a running script causes the
  513.  *    main window to be destroyed, then we need to inform the console
  514.  *    interpreter by invoking "tkConsoleExit".
  515.  *
  516.  * Results:
  517.  *    None.
  518.  *
  519.  * Side effects:
  520.  *    Invokes the "tkConsoleExit" procedure in the console interp.
  521.  *
  522.  *----------------------------------------------------------------------
  523.  */
  524.  
  525. static void
  526. ConsoleEventProc(clientData, eventPtr)
  527.     ClientData clientData;
  528.     XEvent *eventPtr;
  529. {
  530.     ConsoleInfo *info = (ConsoleInfo *) clientData;
  531.     Tcl_Interp *consoleInterp;
  532.     
  533.     if (eventPtr->type == DestroyNotify) {
  534.         consoleInterp = info->consoleInterp;
  535.  
  536.         /*
  537.          * It is possible that the console interpreter itself has
  538.          * already been deleted. In that case the consoleInterp
  539.          * field will be set to NULL. If the interpreter is already
  540.          * gone, we do not have to do any work here.
  541.          */
  542.         
  543.         if (consoleInterp == (Tcl_Interp *) NULL) {
  544.             return;
  545.         }
  546.         Tcl_Preserve((ClientData) consoleInterp);
  547.     Tcl_Eval(consoleInterp, "tkConsoleExit");
  548.         Tcl_Release((ClientData) consoleInterp);
  549.     }
  550. }
  551.  
  552. /*
  553.  *----------------------------------------------------------------------
  554.  *
  555.  * TkConsolePrint --
  556.  *
  557.  *    Prints to the give text to the console.  Given the main interp
  558.  *    this functions find the appropiate console interp and forwards
  559.  *    the text to be added to that console.
  560.  *
  561.  * Results:
  562.  *    None.
  563.  *
  564.  * Side effects:
  565.  *    None.
  566.  *
  567.  *----------------------------------------------------------------------
  568.  */
  569.  
  570. void
  571. TkConsolePrint(interp, devId, buffer, size)
  572.     Tcl_Interp *interp;        /* Main interpreter. */
  573.     int devId;            /* TCL_STDOUT for stdout, TCL_STDERR for
  574.                                  * stderr. */
  575.     char *buffer;        /* Text buffer. */
  576.     long size;            /* Size of text buffer. */
  577. {
  578.     Tcl_DString command, output;
  579.     Tcl_CmdInfo cmdInfo;
  580.     char *cmd;
  581.     ConsoleInfo *info;
  582.     Tcl_Interp *consoleInterp;
  583.     int result;
  584.  
  585.     if (interp == NULL) {
  586.     return;
  587.     }
  588.     
  589.     if (devId == TCL_STDERR) {
  590.     cmd = "tkConsoleOutput stderr ";
  591.     } else {
  592.     cmd = "tkConsoleOutput stdout ";
  593.     }
  594.     
  595.     result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
  596.     if (result == 0) {
  597.     return;
  598.     }
  599.     info = (ConsoleInfo *) cmdInfo.clientData;
  600.     
  601.     Tcl_DStringInit(&output);
  602.     Tcl_DStringAppend(&output, buffer, size);
  603.  
  604.     Tcl_DStringInit(&command);
  605.     Tcl_DStringAppend(&command, cmd, strlen(cmd));
  606.     Tcl_DStringAppendElement(&command, output.string);
  607.  
  608.     consoleInterp = info->consoleInterp;
  609.     Tcl_Preserve((ClientData) consoleInterp);
  610.     Tcl_Eval(consoleInterp, command.string);
  611.     Tcl_Release((ClientData) consoleInterp);
  612.     
  613.     Tcl_DStringFree(&command);
  614.     Tcl_DStringFree(&output);
  615. }
  616.